home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / lib / tk2.3 / dist / tkSend.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-08-13  |  31.0 KB  |  1,134 lines
  1. /* 
  2.  * tkSend.c --
  3.  *
  4.  *    This file provides procedures that implement the "send"
  5.  *    command, allowing commands to be passed from interpreter
  6.  *    to interpreter.
  7.  *
  8.  * Copyright 1989-1992 Regents of the University of California
  9.  * Permission to use, copy, modify, and distribute this
  10.  * software and its documentation for any purpose and without
  11.  * fee is hereby granted, provided that the above copyright
  12.  * notice appear in all copies.  The University of California
  13.  * makes no representations about the suitability of this
  14.  * software for any purpose.  It is provided "as is" without
  15.  * express or implied warranty.
  16.  */
  17.  
  18. #ifndef lint
  19. static char rcsid[] = "$Header: /user6/ouster/wish/RCS/tkSend.c,v 1.26 92/08/13 10:29:26 ouster Exp $ SPRITE (Berkeley)";
  20. #endif
  21.  
  22. #include "tkConfig.h"
  23. #include "tkInt.h"
  24.  
  25. /* 
  26.  * The following structure is used to keep track of the
  27.  * interpreters registered by this process.
  28.  */
  29.  
  30. typedef struct RegisteredInterp {
  31.     char *name;            /* Interpreter's name (malloc-ed). */
  32.     Tcl_Interp *interp;        /* Interpreter associated with
  33.                  * name. */
  34.     TkDisplay *dispPtr;        /* Display associated with name. */
  35.     struct RegisteredInterp *nextPtr;
  36.                 /* Next in list of names associated
  37.                  * with interps in this process.
  38.                  * NULL means end of list. */
  39. } RegisteredInterp;
  40.  
  41. static RegisteredInterp *registry = NULL;
  42.                 /* List of all interpreters
  43.                  * registered by this process. */
  44.  
  45. /*
  46.  * When a result is being awaited from a sent command, one of
  47.  * the following structures is present on a list of all outstanding
  48.  * sent commands.  The information in the structure is used to
  49.  * process the result when it arrives.  You're probably wondering
  50.  * how there could ever be multiple outstanding sent commands.
  51.  * This could happen if interpreters invoke each other recursively.
  52.  * It's unlikely, but possible.
  53.  */
  54.  
  55. typedef struct PendingCommand {
  56.     int serial;            /* Serial number expected in
  57.                  * result. */
  58.     char *target;        /* Name of interpreter command is
  59.                  * being sent to. */
  60.     Tcl_Interp *interp;        /* Interpreter from which the send
  61.                  * was invoked. */
  62.     int code;            /* Tcl return code for command
  63.                  * will be stored here. */
  64.     char *result;        /* String result for command (malloc'ed).
  65.                  * NULL means command still pending. */
  66.     struct PendingCommand *nextPtr;
  67.                 /* Next in list of all outstanding
  68.                  * commands.  NULL means end of
  69.                  * list. */
  70. } PendingCommand;
  71.  
  72. static PendingCommand *pendingCommands = NULL;
  73.                 /* List of all commands currently
  74.                  * being waited for. */
  75.  
  76. /*
  77.  * The information below is used for communication between
  78.  * processes during "send" commands.  Each process keeps a
  79.  * private window, never even mapped, with one property,
  80.  * "Comm".  When a command is sent to an interpreter, the
  81.  * command is appended to the comm property of the communication
  82.  * window associated with the interp's process.  Similarly, when a
  83.  * result is returned from a sent command, it is also appended
  84.  * to the comm property.  In each case, the property information
  85.  * is in the form of an ASCII string.  The exact syntaxes are:
  86.  *
  87.  * Command:
  88.  *    'C' space window space serial space interpName '|' command '\0'
  89.  * The 'C' character indicates that this is a command and not
  90.  * a response.  Window is the hex identifier for the comm
  91.  * window on which to append the response.  Serial is a hex
  92.  * integer containing an identifying number assigned by the
  93.  * sender;  it may be used by the sender to sort out concurrent
  94.  * responses.  InterpName is the ASCII name of the desired
  95.  * interpreter, which must not contain any vertical bar characters
  96.  * The interpreter name is delimited by a vertical bar (this
  97.  * allows the name to include blanks), and is followed by
  98.  * the command to execute.  The command is terminated by a
  99.  * NULL character.
  100.  *
  101.  * Response:
  102.  *    'R' space serial space code space result '\0'
  103.  * The 'R' character indicates that this is a response.  Serial
  104.  * gives the identifier for the command (same value as in the
  105.  * command message).  The code field is a decimal integer giving
  106.  * the Tcl return code from the command, and result is the string
  107.  * result.  The result is terminated by a NULL character.
  108.  *
  109.  * The register of interpreters is kept in a property
  110.  * "InterpRegistry" on the root window of the display.  It is
  111.  * organized as a series of zero or more concatenated strings
  112.  * (in no particular order), each of the form
  113.  *     window space name '\0'
  114.  * where "window" is the hex id of the comm. window to use to talk
  115.  * to an interpreter named "name".
  116.  */
  117.  
  118. /*
  119.  * Maximum size property that can be read at one time by
  120.  * this module:
  121.  */
  122.  
  123. #define MAX_PROP_WORDS 100000
  124.  
  125. /*
  126.  * Forward declarations for procedures defined later in this file:
  127.  */
  128.  
  129. static int    AppendErrorProc _ANSI_ARGS_((ClientData clientData,
  130.             XErrorEvent *errorPtr));
  131. static void    AppendPropCarefully _ANSI_ARGS_((Display *display,
  132.             Window window, Atom property, char *value,
  133.             PendingCommand *pendingPtr));
  134. static void    DeleteProc _ANSI_ARGS_((ClientData clientData));
  135. static Window    LookupName _ANSI_ARGS_((TkDisplay *dispPtr, char *name,
  136.             int delete));
  137. static void    SendEventProc _ANSI_ARGS_((ClientData clientData,
  138.             XEvent *eventPtr));
  139. static int    SendInit _ANSI_ARGS_((Tcl_Interp *interp, TkDisplay *dispPtr));
  140. static Bool    SendRestrictProc _ANSI_ARGS_((Display *display,
  141.             XEvent *eventPtr, char *arg));
  142. static void    TimeoutProc _ANSI_ARGS_((ClientData clientData));
  143.  
  144. /*
  145.  *--------------------------------------------------------------
  146.  *
  147.  * Tk_RegisterInterp --
  148.  *
  149.  *    This procedure is called to associate an ASCII name
  150.  *    with an interpreter.  Tk_InitSend must previously
  151.  *    have been called to set up communication channels
  152.  *    and specify a display.
  153.  *
  154.  * Results:
  155.  *    Zero is returned if the name was registered successfully.
  156.  *    Non-zero means the name was already in use.
  157.  *
  158.  * Side effects:
  159.  *    Registration info is saved, thereby allowing the
  160.  *    "send" command to be used later to invoke commands
  161.  *    in the interpreter.  The registration will be removed
  162.  *    automatically when the interpreter is deleted.
  163.  *
  164.  *--------------------------------------------------------------
  165.  */
  166.  
  167. int
  168. Tk_RegisterInterp(interp, name, tkwin)
  169.     Tcl_Interp *interp;        /* Interpreter associated with name. */
  170.     char *name;            /* The name that will be used to
  171.                  * refer to the interpreter in later
  172.                  * "send" commands.  Must be globally
  173.                  * unique. */
  174.     Tk_Window tkwin;        /* Token for window associated with
  175.                  * interp;  used to identify display
  176.                  * for communication.  */
  177. {
  178. #define TCL_MAX_NAME_LENGTH 1000
  179.     char propInfo[TCL_MAX_NAME_LENGTH + 20];
  180.     register RegisteredInterp *riPtr;
  181.     Window w;
  182.     TkWindow *winPtr = (TkWindow *) tkwin;
  183.     TkDisplay *dispPtr;
  184.  
  185.     if (strchr(name, '|') != NULL) {
  186.     interp->result =
  187.         "interpreter name cannot contain '|' character";
  188.     return TCL_ERROR;
  189.     }
  190.  
  191.     dispPtr = winPtr->dispPtr;
  192.     if (dispPtr->commWindow == NULL) {
  193.     int result;
  194.  
  195.     result = SendInit(interp, dispPtr);
  196.     if (result != TCL_OK) {
  197.         return result;
  198.     }
  199.     }
  200.  
  201.     /*
  202.      * Make sure the name is unique, and append info about it to
  203.      * the registry property.  Eventually, it would probably be
  204.      * a good idea to lock the server here to prevent conflicting
  205.      * changes to the registry property.  But that would make
  206.      * testing more difficult, and probably isn't necessary
  207.      * anyway because new windows don't get created all that often.
  208.      */
  209.  
  210.     w = LookupName(dispPtr, name, 0);
  211.     if (w != (Window) 0) {
  212.     Tcl_Interp *tmpInterp;
  213.     RegisteredInterp tmpRi;
  214.     int result;
  215.     char *argv[3];
  216.  
  217.     /*
  218.      * Name already exists.  Ping the interpreter with a
  219.      * NULL command to see if it already exists.  If not,
  220.      * unregister the old name (this could happen if an
  221.      * application dies without cleaning up the registry).
  222.      */
  223.  
  224.     tmpInterp = Tcl_CreateInterp();
  225.     argv[0] = "send";
  226.     argv[1] = name;
  227.     argv[2] = "";
  228.     tmpRi.dispPtr = dispPtr;
  229.     result = Tk_SendCmd((ClientData) &tmpRi, tmpInterp, 3, argv);
  230.     Tcl_DeleteInterp(tmpInterp);
  231.     if (result == TCL_OK) {
  232.         Tcl_AppendResult(interp, "interpreter name \"", name,
  233.             "\" is already in use", (char *) NULL);
  234.         return TCL_ERROR;
  235.     }
  236.     (void) LookupName(winPtr->dispPtr, name, 1);
  237.     }
  238.     sprintf(propInfo, "%x %.*s", Tk_WindowId(dispPtr->commWindow),
  239.         TCL_MAX_NAME_LENGTH, name);
  240.     XChangeProperty(dispPtr->display,
  241.         DefaultRootWindow(dispPtr->display),
  242.         dispPtr->registryProperty, XA_STRING, 8, PropModeAppend,
  243.         (unsigned char *) propInfo, strlen(propInfo)+1);
  244.  
  245.     /*
  246.      * Add an entry in the local registry of names owned by this
  247.      * process.
  248.      */
  249.  
  250.     riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
  251.     riPtr->name = (char *) ckalloc((unsigned) (strlen(name) + 1));
  252.     strcpy(riPtr->name, name);
  253.     riPtr->interp = interp;
  254.     riPtr->dispPtr = dispPtr;
  255.     riPtr->nextPtr = registry;
  256.     registry = riPtr;
  257.  
  258.     /*
  259.      * Add the "send" command to this interpreter, and arrange for
  260.      * us to be notified when the interpreter is deleted (actually,
  261.      * when the "send" command is deleted).
  262.      */
  263.  
  264.     Tcl_CreateCommand(interp, "send", Tk_SendCmd, (ClientData) riPtr,
  265.         DeleteProc);
  266.  
  267.     return TCL_OK;
  268. }
  269.  
  270. /*
  271.  *--------------------------------------------------------------
  272.  *
  273.  * Tk_SendCmd --
  274.  *
  275.  *    This procedure is invoked to process the "send" Tcl command.
  276.  *    See the user documentation for details on what it does.
  277.  *
  278.  * Results:
  279.  *    A standard Tcl result.
  280.  *
  281.  * Side effects:
  282.  *    See the user documentation.
  283.  *
  284.  *--------------------------------------------------------------
  285.  */
  286.  
  287. int
  288. Tk_SendCmd(clientData, interp, argc, argv)
  289.     ClientData clientData;        /* Information about sender (only
  290.                      * dispPtr field is used). */
  291.     Tcl_Interp *interp;            /* Current interpreter. */
  292.     int argc;                /* Number of arguments. */
  293.     char **argv;            /* Argument strings. */
  294. {
  295.     RegisteredInterp *senderRiPtr = (RegisteredInterp *) clientData;
  296.     Window w;
  297. #define STATIC_PROP_SPACE 100
  298.     char *property, staticSpace[STATIC_PROP_SPACE];
  299.     int length;
  300.     static int serial = 0;    /* Running count of sent commands.
  301.                  * Used to give each command a
  302.                  * different serial number. */
  303.     PendingCommand pending;
  304.     Tk_TimerToken timeout;
  305.     register RegisteredInterp *riPtr;
  306.     char *cmd;
  307.     int result;
  308.     Bool (*prevRestrictProc)();
  309.     char *prevArg;
  310.     TkDisplay *dispPtr = senderRiPtr->dispPtr;
  311.  
  312.     if (dispPtr->commWindow == NULL) {
  313.     result = SendInit(interp, dispPtr);
  314.     if (result != TCL_OK) {
  315.         return result;
  316.     }
  317.     }
  318.  
  319.     if (argc < 3) {
  320.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  321.         " interpName arg ?arg ...?\"", (char *) NULL);
  322.     return TCL_ERROR;
  323.     }
  324.     if (argc == 3) {
  325.     cmd = argv[2];
  326.     } else {
  327.     cmd = Tcl_Concat(argc-2, argv+2);
  328.     }
  329.  
  330.     /*
  331.      * See if the target interpreter is local.  If so, execute
  332.      * the command directly without going through the X server.
  333.      * The only tricky thing is passing the result from the target
  334.      * interpreter to the invoking interpreter.  Watch out:  they
  335.      * could be the same!
  336.      */
  337.  
  338.     for (riPtr = registry; riPtr != NULL; riPtr = riPtr->nextPtr) {
  339.     if (strcmp(riPtr->name, argv[1]) != 0) {
  340.         continue;
  341.     }
  342.     if (interp == riPtr->interp) {
  343.         result = Tcl_GlobalEval(interp, cmd);
  344.     } else {
  345.         result = Tcl_GlobalEval(riPtr->interp, cmd);
  346.         interp->result = riPtr->interp->result;
  347.         interp->freeProc = riPtr->interp->freeProc;
  348.         riPtr->interp->freeProc = 0;
  349.         Tcl_ResetResult(riPtr->interp);
  350.     }
  351.     if (cmd != argv[2]) {
  352.         ckfree(cmd);
  353.     }
  354.     return result;
  355.     }
  356.  
  357.     /*
  358.      * Bind the interpreter name to a communication window.
  359.      */
  360.  
  361.     w = LookupName(dispPtr, argv[1], 0);
  362.     if (w == 0) {
  363.     Tcl_AppendResult(interp, "no registered interpeter named \"",
  364.         argv[1], "\"", (char *) NULL);
  365.     if (cmd != argv[2]) {
  366.         ckfree(cmd);
  367.     }
  368.     return TCL_ERROR;
  369.     }
  370.  
  371.     /*
  372.      * Register the fact that we're waiting for a command to
  373.      * complete (this is needed by SendEventProc and by
  374.      * AppendErrorProc to pass back the command's results).
  375.      */
  376.  
  377.     serial++;
  378.     pending.serial = serial;
  379.     pending.target = argv[1];
  380.     pending.interp = interp;
  381.     pending.result = NULL;
  382.     pending.nextPtr = pendingCommands;
  383.     pendingCommands = &pending;
  384.  
  385.     /*
  386.      * Send the command to target interpreter by appending it to the
  387.      * comm window in the communication window.
  388.      */
  389.  
  390.     length = strlen(argv[1]) + strlen(cmd) + 30;
  391.     if (length <= STATIC_PROP_SPACE) {
  392.     property = staticSpace;
  393.     } else {
  394.     property = (char *) ckalloc((unsigned) length);
  395.     }
  396.     sprintf(property, "C %x %x %s|%s",
  397.         Tk_WindowId(dispPtr->commWindow), serial, argv[1], cmd);
  398.     (void) AppendPropCarefully(dispPtr->display, w, dispPtr->commProperty,
  399.         property, &pending);
  400.     if (length > STATIC_PROP_SPACE) {
  401.     ckfree(property);
  402.     }
  403.     if (cmd != argv[2]) {
  404.     ckfree(cmd);
  405.     }
  406.  
  407.     /*
  408.      * Enter a loop processing X events until the result comes
  409.      * in.  If no response is received within a few seconds,
  410.      * then timeout.  While waiting for a result, look only at
  411.      * send-related events (otherwise it would be possible for
  412.      * additional input events, such as mouse motion, to cause
  413.      * other sends, leading eventually to such a large number
  414.      * of nested Tcl_Eval calls that the Tcl interpreter panics).
  415.      */
  416.  
  417.     prevRestrictProc = Tk_RestrictEvents(SendRestrictProc,
  418.         (char *) dispPtr->commWindow, &prevArg);
  419.     timeout = Tk_CreateTimerHandler(5000, TimeoutProc,
  420.         (ClientData) &pending);
  421.     while (pending.result == NULL) {
  422.     Tk_DoOneEvent(0);
  423.     }
  424.     Tk_DeleteTimerHandler(timeout);
  425.     (void) Tk_RestrictEvents(prevRestrictProc, prevArg, &prevArg);
  426.  
  427.     /*
  428.      * Unregister the information about the pending command
  429.      * and return the result.
  430.      */
  431.  
  432.     if (pendingCommands == &pending) {
  433.     pendingCommands = pending.nextPtr;
  434.     } else {
  435.     PendingCommand *pcPtr;
  436.  
  437.     for (pcPtr = pendingCommands; pcPtr != NULL;
  438.         pcPtr = pcPtr->nextPtr) {
  439.         if (pcPtr->nextPtr == &pending) {
  440.         pcPtr->nextPtr = pending.nextPtr;
  441.         break;
  442.         }
  443.     }
  444.     }
  445.     Tcl_SetResult(interp, pending.result, TCL_DYNAMIC);
  446.     return pending.code;
  447. }
  448.  
  449. /*
  450.  *----------------------------------------------------------------------
  451.  *
  452.  * TkGetInterpNames --
  453.  *
  454.  *    This procedure is invoked to fetch a list of all the
  455.  *    interpreter names currently registered for the display
  456.  *    of a particular window.
  457.  *
  458.  * Results:
  459.  *    A standard Tcl return value.  Interp->result will be set
  460.  *    to hold a list of all the interpreter names defined for
  461.  *    tkwin's display.  If an error occurs, then TCL_ERROR
  462.  *    is returned and interp->result will hold an error message.
  463.  *
  464.  * Side effects:
  465.  *    None.
  466.  *
  467.  *----------------------------------------------------------------------
  468.  */
  469.  
  470. int
  471. TkGetInterpNames(interp, tkwin)
  472.     Tcl_Interp *interp;        /* Interpreter for returning a result. */
  473.     Tk_Window tkwin;        /* Window whose display is to be used
  474.                  * for the lookup. */
  475. {
  476.     TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
  477.     char *regProp, *separator, *name;
  478.     register char *p;
  479.     int result, actualFormat;
  480.     unsigned long numItems, bytesAfter;
  481.     Atom actualType;
  482.  
  483.     /*
  484.      * Read the registry property.
  485.      */
  486.  
  487.     regProp = NULL;
  488.     result = XGetWindowProperty(dispPtr->display,
  489.         DefaultRootWindow(dispPtr->display),
  490.         dispPtr->registryProperty, 0, MAX_PROP_WORDS,
  491.         False, XA_STRING, &actualType, &actualFormat,
  492.         &numItems, &bytesAfter, (unsigned char **) ®Prop);
  493.  
  494.     if (actualType == None) {
  495.     sprintf(interp->result, "couldn't read intepreter registry property");
  496.     return TCL_ERROR;
  497.     }
  498.  
  499.     /*
  500.      * If the property is improperly formed, then delete it.
  501.      */
  502.  
  503.     if ((result != Success) || (actualFormat != 8)
  504.         || (actualType != XA_STRING)) {
  505.     if (regProp != NULL) {
  506.         XFree(regProp);
  507.     }
  508.     sprintf(interp->result, "intepreter registry property is badly formed");
  509.     return TCL_ERROR;
  510.     }
  511.  
  512.     /*
  513.      * Scan all of the names out of the property.
  514.      */
  515.  
  516.     separator = "";
  517.     for (p = regProp; (p-regProp) < numItems; p++) {
  518.     name = p;
  519.     while ((*p != 0) && (!isspace(*p))) {
  520.         p++;
  521.     }
  522.     if (*p != 0) {
  523.         name = p+1;
  524.         name = Tcl_Merge(1, &name);
  525.         Tcl_AppendResult(interp, separator, name, (char *) NULL);
  526.         while (*p != 0) {
  527.         p++;
  528.         }
  529.         separator = " ";
  530.     }
  531.     }
  532.     XFree(regProp);
  533.     return TCL_OK;
  534. }
  535.  
  536. /*
  537.  *--------------------------------------------------------------
  538.  *
  539.  * SendInit --
  540.  *
  541.  *    This procedure is called to initialize the
  542.  *    communication channels for sending commands and
  543.  *    receiving results.
  544.  *
  545.  * Results:
  546.  *    The result is a standard Tcl return value, which is
  547.  *    normally TCL_OK.  If an error occurs then an error
  548.  *    message is left in interp->result and TCL_ERROR is
  549.  *    returned.
  550.  *
  551.  * Side effects:
  552.  *    Sets up various data structures and windows.
  553.  *
  554.  *--------------------------------------------------------------
  555.  */
  556.  
  557. static int
  558. SendInit(interp, dispPtr)
  559.     Tcl_Interp *interp;        /* Interpreter to use for error
  560.                  * reporting. */
  561.     register TkDisplay *dispPtr;/* Display to initialize. */
  562.  
  563. {
  564.     XSetWindowAttributes atts;
  565.  
  566.     /*
  567.      * Create the window used for communication, and set up an
  568.      * event handler for it.
  569.      */
  570.  
  571.     dispPtr->commWindow = Tk_CreateWindow(interp, (Tk_Window) NULL,
  572.         "_comm", DisplayString(dispPtr->display));
  573.     if (dispPtr->commWindow == NULL) {
  574.     return TCL_ERROR;
  575.     }
  576.     atts.override_redirect = True;
  577.     Tk_ChangeWindowAttributes(dispPtr->commWindow,
  578.         CWOverrideRedirect, &atts);
  579.     Tk_CreateEventHandler(dispPtr->commWindow, PropertyChangeMask,
  580.         SendEventProc, (ClientData) dispPtr);
  581.     Tk_MakeWindowExist(dispPtr->commWindow);
  582.  
  583.     /*
  584.      * Get atoms used as property names.
  585.      */
  586.  
  587.     dispPtr->commProperty = XInternAtom(dispPtr->display,
  588.         "Comm", False);
  589.     dispPtr->registryProperty = XInternAtom(dispPtr->display,
  590.         "InterpRegistry", False);
  591.     return TCL_OK;
  592. }
  593.  
  594. /*
  595.  *--------------------------------------------------------------
  596.  *
  597.  * LookupName --
  598.  *
  599.  *    Given an interpreter name, see if the name exists in
  600.  *    the interpreter registry for a particular display.
  601.  *
  602.  * Results:
  603.  *    If the given name is registered, return the ID of
  604.  *    the window associated with the name.  If the name
  605.  *    isn't registered, then return 0.
  606.  *
  607.  * Side effects:
  608.  *    If the registry property is improperly formed, then
  609.  *    it is deleted.  If "delete" is non-zero, then if the
  610.  *    named interpreter is found it is removed from the
  611.  *    registry property.
  612.  *
  613.  *--------------------------------------------------------------
  614.  */
  615.  
  616. static Window
  617. LookupName(dispPtr, name, delete)
  618.     register TkDisplay *dispPtr;
  619.             /* Display whose registry to check. */
  620.     char *name;        /* Name of an interpreter. */
  621.     int delete;        /* If non-zero, delete info about name. */
  622. {
  623.     char *regProp, *entry;
  624.     register char *p;
  625.     int result, actualFormat;
  626.     unsigned long numItems, bytesAfter;
  627.     Atom actualType;
  628.     Window returnValue;
  629.  
  630.     /*
  631.      * Read the registry property.
  632.      */
  633.  
  634.     regProp = NULL;
  635.     result = XGetWindowProperty(dispPtr->display,
  636.         DefaultRootWindow(dispPtr->display),
  637.         dispPtr->registryProperty, 0, MAX_PROP_WORDS,
  638.         False, XA_STRING, &actualType, &actualFormat,
  639.         &numItems, &bytesAfter, (unsigned char **) ®Prop);
  640.  
  641.     if (actualType == None) {
  642.     return 0;
  643.     }
  644.  
  645.     /*
  646.      * If the property is improperly formed, then delete it.
  647.      */
  648.  
  649.     if ((result != Success) || (actualFormat != 8)
  650.         || (actualType != XA_STRING)) {
  651.     if (regProp != NULL) {
  652.         XFree(regProp);
  653.     }
  654.     XDeleteProperty(dispPtr->display,
  655.         DefaultRootWindow(dispPtr->display),
  656.         dispPtr->registryProperty);
  657.     return 0;
  658.     }
  659.  
  660.     /*
  661.      * Scan the property for the desired name.
  662.      */
  663.  
  664.     returnValue = (Window) 0;
  665.     entry = NULL;    /* Not needed, but eliminates compiler warning. */
  666.     for (p = regProp; (p-regProp) < numItems; ) {
  667.     entry = p;
  668.     while ((*p != 0) && (!isspace(*p))) {
  669.         p++;
  670.     }
  671.     if ((*p != 0) && (strcmp(name, p+1) == 0)) {
  672.         sscanf(entry, "%x", &returnValue);
  673.         break;
  674.     }
  675.     while (*p != 0) {
  676.         p++;
  677.     }
  678.     p++;
  679.     }
  680.  
  681.     /*
  682.      * Delete the property, if that is desired (copy down the
  683.      * remainder of the registry property to overlay the deleted
  684.      * info, then rewrite the property).
  685.      */
  686.  
  687.     if ((delete) && (returnValue != 0)) {
  688.     int count;
  689.  
  690.     while (*p != 0) {
  691.         p++;
  692.     }
  693.     p++;
  694.     count = numItems - (p-regProp);
  695.     if (count > 0) {
  696.         memcpy((VOID *) entry, (VOID *) p, count);
  697.     }
  698.     XChangeProperty(dispPtr->display,
  699.         DefaultRootWindow(dispPtr->display),
  700.         dispPtr->registryProperty, XA_STRING, 8,
  701.         PropModeReplace, (unsigned char *) regProp,
  702.         (int) (numItems - (p-entry)));
  703.     XSync(dispPtr->display, False);
  704.     }
  705.  
  706.     XFree(regProp);
  707.     return returnValue;
  708. }
  709.  
  710. /*
  711.  *--------------------------------------------------------------
  712.  *
  713.  * SendEventProc --
  714.  *
  715.  *    This procedure is invoked automatically by the toolkit
  716.  *    event manager when a property changes on the communication
  717.  *    window.  This procedure reads the property and handles
  718.  *    command requests and responses.
  719.  *
  720.  * Results:
  721.  *    None.
  722.  *
  723.  * Side effects:
  724.  *    If there are command requests in the property, they
  725.  *    are executed.  If there are responses in the property,
  726.  *    their information is saved for the (ostensibly waiting)
  727.  *    "send" commands. The property is deleted.
  728.  *
  729.  *--------------------------------------------------------------
  730.  */
  731.  
  732. static void
  733. SendEventProc(clientData, eventPtr)
  734.     ClientData clientData;    /* Display information. */    
  735.     XEvent *eventPtr;        /* Information about event. */
  736. {
  737.     TkDisplay *dispPtr = (TkDisplay *) clientData;
  738.     char *propInfo;
  739.     register char *p;
  740.     int result, actualFormat;
  741.     unsigned long numItems, bytesAfter;
  742.     Atom actualType;
  743.  
  744.     if ((eventPtr->xproperty.atom != dispPtr->commProperty)
  745.         || (eventPtr->xproperty.state != PropertyNewValue)) {
  746.     return;
  747.     }
  748.  
  749.     /*
  750.      * Read the comm property and delete it.
  751.      */
  752.  
  753.     propInfo = NULL;
  754.     result = XGetWindowProperty(dispPtr->display,
  755.         Tk_WindowId(dispPtr->commWindow),
  756.         dispPtr->commProperty, 0, MAX_PROP_WORDS, True,
  757.         XA_STRING, &actualType, &actualFormat,
  758.         &numItems, &bytesAfter, (unsigned char **) &propInfo);
  759.  
  760.     /*
  761.      * If the property doesn't exist or is improperly formed
  762.      * then ignore it.
  763.      */
  764.  
  765.     if ((result != Success) || (actualType != XA_STRING)
  766.         || (actualFormat != 8)) {
  767.     if (propInfo != NULL) {
  768.         XFree(propInfo);
  769.     }
  770.     return;
  771.     }
  772.  
  773.     /*
  774.      * The property is divided into records separated by null
  775.      * characters.  Each record represents one command request
  776.      * or response.  Scan through the property one record at a
  777.      * time.
  778.      */
  779.  
  780.     for (p = propInfo; (p-propInfo) < numItems; ) {
  781.     if (*p == 'C') {
  782.         Window window;
  783.         int serial, resultSize;
  784.         char *resultString, *interpName, *returnProp, *end;
  785.         register RegisteredInterp *riPtr;
  786.         char errorMsg[100];
  787. #define STATIC_RESULT_SPACE 100
  788.         char staticSpace[STATIC_RESULT_SPACE];
  789.  
  790.         /*
  791.          *-----------------------------------------------------
  792.          * This is an incoming command sent by another window.
  793.          * Parse the fields of the command string.  If the command
  794.          * string isn't properly formed, send back an error message
  795.          * if there's enough well-formed information to generate
  796.          * a proper reply;  otherwise just ignore the message.
  797.          *-----------------------------------------------------
  798.          */
  799.  
  800.         p++;
  801.         window = (Window) strtol(p, &end, 16);
  802.         if (end == p) {
  803.         goto nextRecord;
  804.         }
  805.         p = end;
  806.         if (*p != ' ') {
  807.         goto nextRecord;
  808.         }
  809.         p++;
  810.         serial = strtol(p, &end, 16);
  811.         if (end == p) {
  812.         goto nextRecord;
  813.         }
  814.         p = end;
  815.         if (*p != ' ') {
  816.         goto nextRecord;
  817.         }
  818.         p++;
  819.         interpName = p;
  820.         while ((*p != 0) && (*p != '|')) {
  821.         p++;
  822.         }
  823.         if (*p != '|') {
  824.         result = TCL_ERROR;
  825.         resultString = "bad property format for sent command";
  826.         goto returnResult;
  827.         }
  828.         *p = 0;
  829.         p++;
  830.  
  831.         /*
  832.          * Locate the interpreter for the command, then
  833.          * execute the command.
  834.          */
  835.  
  836.         for (riPtr = registry; ; riPtr = riPtr->nextPtr) {
  837.         if (riPtr == NULL) {
  838.             result = TCL_ERROR;
  839.             sprintf(errorMsg,
  840.                 "receiver never heard of interpreter \"%.40s\"",
  841.                 interpName);
  842.             resultString = errorMsg;
  843.             goto returnResult;
  844.         }
  845.         if (strcmp(riPtr->name, interpName) == 0) {
  846.             break;
  847.         }
  848.         }
  849.         result = Tcl_GlobalEval(riPtr->interp, p);
  850.         resultString = riPtr->interp->result;
  851.  
  852.         /*
  853.          * Return the result to the sender.
  854.          */
  855.  
  856.         returnResult:
  857.         resultSize = strlen(resultString) + 30;
  858.         if (resultSize <= STATIC_RESULT_SPACE) {
  859.         returnProp = staticSpace;
  860.         } else {
  861.         returnProp = (char *) ckalloc((unsigned) resultSize);
  862.         }
  863.         sprintf(returnProp, "R %x %d %s", serial, result,
  864.             resultString);
  865.         (void) AppendPropCarefully(dispPtr->display, window,
  866.             dispPtr->commProperty, returnProp,
  867.             (PendingCommand *) NULL);
  868.         if (returnProp != staticSpace) {
  869.         ckfree(returnProp);
  870.         }
  871.     } else if (*p == 'R') {
  872.         int serial, code;
  873.         char *end;
  874.         register PendingCommand *pcPtr;
  875.  
  876.         /*
  877.          *-----------------------------------------------------
  878.          * This record in the property is a result being
  879.          * returned for a command sent from here.  First
  880.          * parse the fields.
  881.          *-----------------------------------------------------
  882.          */
  883.  
  884.         p++;
  885.         serial = strtol(p, &end, 16);
  886.         if (end == p) {
  887.         goto nextRecord;
  888.         }
  889.         p = end;
  890.         if (*p != ' ') {
  891.         goto nextRecord;
  892.         }
  893.         p++;
  894.         code = strtol(p, &end, 10);
  895.         if (end == p) {
  896.         goto nextRecord;
  897.         }
  898.         p = end;
  899.         if (*p != ' ') {
  900.         goto nextRecord;
  901.         }
  902.         p++;
  903.  
  904.         /*
  905.          * Give the result information to anyone who's
  906.          * waiting for it.
  907.          */
  908.  
  909.         for (pcPtr = pendingCommands; pcPtr != NULL;
  910.             pcPtr = pcPtr->nextPtr) {
  911.         if ((serial != pcPtr->serial) || (pcPtr->result != NULL)) {
  912.             continue;
  913.         }
  914.         pcPtr->code = code;
  915.         pcPtr->result = ckalloc((unsigned) (strlen(p) + 1));
  916.         strcpy(pcPtr->result, p);
  917.         break;
  918.         }
  919.     }
  920.  
  921.     nextRecord:
  922.     while (*p != 0) {
  923.         p++;
  924.     }
  925.     p++;
  926.     }
  927.     XFree(propInfo);
  928. }
  929.  
  930. /*
  931.  *--------------------------------------------------------------
  932.  *
  933.  * AppendPropCarefully --
  934.  *
  935.  *    Append a given property to a given window, but set up
  936.  *    an X error handler so that if the append fails this
  937.  *    procedure can return an error code rather than having
  938.  *    Xlib panic.
  939.  *
  940.  * Results:
  941.  *    None.
  942.  *
  943.  * Side effects:
  944.  *    The given property on the given window is appended to.
  945.  *    If this operation fails and if pendingPtr is non-NULL,
  946.  *    then the pending operation is marked as complete with
  947.  *    an error.
  948.  *
  949.  *--------------------------------------------------------------
  950.  */
  951.  
  952. static void
  953. AppendPropCarefully(display, window, property, value, pendingPtr)
  954.     Display *display;        /* Display on which to operate. */
  955.     Window window;        /* Window whose property is to
  956.                  * be modified. */
  957.     Atom property;        /* Name of property. */
  958.     char *value;        /* Characters (null-terminated) to
  959.                  * append to property. */
  960.     PendingCommand *pendingPtr;    /* Pending command to mark complete
  961.                  * if an error occurs during the
  962.                  * property op.  NULL means just
  963.                  * ignore the error. */
  964. {
  965.     Tk_ErrorHandler handler;
  966.  
  967.     handler = Tk_CreateErrorHandler(display, -1, -1, -1, AppendErrorProc,
  968.     (ClientData) pendingPtr);
  969.     XChangeProperty(display, window, property, XA_STRING, 8,
  970.         PropModeAppend, (unsigned char *) value, strlen(value)+1);
  971.     Tk_DeleteErrorHandler(handler);
  972. }
  973.  
  974. /*
  975.  * The procedure below is invoked if an error occurs during
  976.  * the XChangeProperty operation above.
  977.  */
  978.  
  979.     /* ARGSUSED */
  980. static int
  981. AppendErrorProc(clientData, errorPtr)
  982.     ClientData clientData;    /* Command to mark complete, or NULL. */
  983.     XErrorEvent *errorPtr;    /* Information about error. */
  984. {
  985.     PendingCommand *pendingPtr = (PendingCommand *) clientData;
  986.     register PendingCommand *pcPtr;
  987.  
  988.     if (pendingPtr == NULL) {
  989.     return 0;
  990.     }
  991.  
  992.     /*
  993.      * Make sure this command is still pending.
  994.      */
  995.  
  996.     for (pcPtr = pendingCommands; pcPtr != NULL;
  997.         pcPtr = pcPtr->nextPtr) {
  998.     if ((pcPtr == pendingPtr) && (pcPtr->result == NULL)) {
  999.         pcPtr->result = ckalloc((unsigned) (strlen(pcPtr->target) + 50));
  1000.         sprintf(pcPtr->result,
  1001.             "send to \"%s\" failed (no communication window)",
  1002.             pcPtr->target);
  1003.         pcPtr->code = TCL_ERROR;
  1004.         break;
  1005.     }
  1006.     }
  1007.     return 0;
  1008. }
  1009.  
  1010. /*
  1011.  *--------------------------------------------------------------
  1012.  *
  1013.  * TimeoutProc --
  1014.  *
  1015.  *    This procedure is invoked when too much time has elapsed
  1016.  *    during the processing of a sent command.
  1017.  *
  1018.  * Results:
  1019.  *    None.
  1020.  *
  1021.  * Side effects:
  1022.  *    Mark the pending command as complete, with an error
  1023.  *    message signalling the timeout.
  1024.  *
  1025.  *--------------------------------------------------------------
  1026.  */
  1027.  
  1028. static void
  1029. TimeoutProc(clientData)
  1030.     ClientData clientData;    /* Information about command that
  1031.                  * has been sent but not yet
  1032.                  * responded to. */
  1033. {
  1034.     PendingCommand *pcPtr = (PendingCommand *) clientData;
  1035.     register PendingCommand *pcPtr2;
  1036.  
  1037.     /*
  1038.      * Make sure that the command is still in the pending list
  1039.      * and that it hasn't already completed.  Then register the
  1040.      * error.
  1041.      */
  1042.  
  1043.     for (pcPtr2 = pendingCommands; pcPtr2 != NULL;
  1044.         pcPtr2 = pcPtr2->nextPtr) {
  1045.     static char msg[] = "remote interpreter did not respond";
  1046.     if ((pcPtr2 != pcPtr) || (pcPtr2->result != NULL)) {
  1047.         continue;
  1048.     }
  1049.     pcPtr2->code = TCL_ERROR;
  1050.     pcPtr2->result = ckalloc((unsigned) (sizeof(msg) + 1));
  1051.     strcpy(pcPtr2->result, msg);
  1052.     return;
  1053.     }
  1054. }
  1055.  
  1056. /*
  1057.  *--------------------------------------------------------------
  1058.  *
  1059.  * DeleteProc --
  1060.  *
  1061.  *    This procedure is invoked by Tcl when a registered
  1062.  *    interpreter is about to be deleted.  It unregisters
  1063.  *    the interpreter.
  1064.  *
  1065.  * Results:
  1066.  *    None.
  1067.  *
  1068.  * Side effects:
  1069.  *    The interpreter given by riPtr is unregistered.
  1070.  *
  1071.  *--------------------------------------------------------------
  1072.  */
  1073.  
  1074. static void
  1075. DeleteProc(clientData)
  1076.     ClientData clientData;    /* Info about registration, passed
  1077.                  * as ClientData. */
  1078. {
  1079.     RegisteredInterp *riPtr = (RegisteredInterp *) clientData;
  1080.     register RegisteredInterp *riPtr2;
  1081.  
  1082.     (void) LookupName(riPtr->dispPtr, riPtr->name, 1);
  1083.     if (registry == riPtr) {
  1084.     registry = riPtr->nextPtr;
  1085.     } else {
  1086.     for (riPtr2 = registry; riPtr2 != NULL;
  1087.         riPtr2 = riPtr2->nextPtr) {
  1088.         if (riPtr2->nextPtr == riPtr) {
  1089.         riPtr2->nextPtr = riPtr->nextPtr;
  1090.         break;
  1091.         }
  1092.     }
  1093.     }
  1094.     ckfree((char *) riPtr->name);
  1095.     ckfree((char *) riPtr);
  1096. }
  1097.  
  1098. /*
  1099.  *----------------------------------------------------------------------
  1100.  *
  1101.  * SendRestrictProc --
  1102.  *
  1103.  *    This procedure filters incoming events when a "send" command
  1104.  *    is outstanding.  It defers all events except those containing
  1105.  *    send commands and results.
  1106.  *
  1107.  * Results:
  1108.  *    False is returned except for property-change events on the
  1109.  *    given commWindow.
  1110.  *
  1111.  * Side effects:
  1112.  *    None.
  1113.  *
  1114.  *----------------------------------------------------------------------
  1115.  */
  1116.  
  1117.     /* ARGSUSED */
  1118. static Bool
  1119. SendRestrictProc(display, eventPtr, arg)
  1120.     Display *display;        /* Display from which event arrived. */
  1121.     register XEvent *eventPtr;    /* Event that just arrived. */
  1122.     char *arg;            /* Comunication window in which
  1123.                  * we're interested. */
  1124. {
  1125.     register Tk_Window comm = (Tk_Window) arg;
  1126.  
  1127.     if ((display != Tk_Display(comm))
  1128.         || (eventPtr->type != PropertyNotify)
  1129.         || (eventPtr->xproperty.window != Tk_WindowId(comm))) {
  1130.     return False;
  1131.     }
  1132.     return True;
  1133. }
  1134.